home *** CD-ROM | disk | FTP | other *** search
/ Hyper Stacks 1994 May / Hyper Stacks (Pacific HiTech)(1994)[Mac].iso / Sounds & Music / HyperSounds / HyperSnd.p < prev    next >
Text File  |  1988-01-09  |  2KB  |  107 lines
  1. {$R-}
  2.  
  3. {$S HyperSound }     { Segment name must be the same as the command name. }
  4.  
  5. UNIT DummyUnit;
  6.  
  7. INTERFACE
  8.  
  9. USES MemTypes, QuickDraw, OSIntf, toolIntf, hyperxcmd;
  10.  
  11. PROCEDURE ENTRYPOINT(paramPtr: XCmdPtr);
  12.     
  13. IMPLEMENTATION
  14.  
  15. TYPE Str31 = String[31];
  16.  
  17. PROCEDURE HyperSnd(paramPtr: XCmdPtr);                             FORWARD;
  18.  
  19.     PROCEDURE ENTRYPOINT(paramPtr: XCmdPtr);
  20.     BEGIN
  21.         HyperSnd(paramPtr);
  22.     END;
  23.  
  24.     PROCEDURE HyperSnd(paramPtr: XCmdPtr);
  25.     TYPE
  26.         T1 = RECORD
  27.             Typ: Integer;
  28.             Sz: Integer;
  29.             F: ARRAY [1..100] OF RECORD
  30.                 Typ: Integer;
  31.                 Modi: LongInt;
  32.                 END;
  33.             END;
  34.         T2 = RECORD
  35.             Sz: Integer;
  36.             F: ARRAY [1..100] OF RECORD
  37.                 Cmd: Integer;
  38.                 Mod1: Integer;
  39.                 Mod2: LongInt;
  40.                 END;
  41.             END;
  42.         
  43.         P1 = ^T1;
  44.         P2 = ^T2;
  45.         H1 = ^P1;
  46.     VAR Res: H1;
  47.         Ps: P2;
  48.         i,j: Integer;
  49.         ch: boolean;
  50.         iff: longint;
  51.         uff: integer;
  52.     BEGIN
  53.         i := 0;
  54.         while true do begin
  55.             ch := false;
  56.             uff := 0;
  57.             i := i+1;
  58.             handle(res) := get1indresource ('snd ', i);
  59.             if res = nil then exit(hypersnd);
  60.             if (res^^.typ = 1) OR (res^^.typ = 2) then begin
  61.                 IF Res^^.Typ = 1 then begin
  62.                     res^^.Typ := 2;
  63.                     uff := uff - 6*res^^.sz;
  64.                     iff := munger (handle(res), 4, nil, 6*res^^.sz, @iff, 0);
  65.                     res^^.Sz := 0;
  66.                     ch := true;
  67.                     end;
  68.                 hLock(handle(res));
  69.                 ptr(Ps) := ptr(ord4(res^)+4+6*res^^.sz);
  70.                 if (ps^.sz = 1) and (ps^.f[1].cmd = $8051) then begin
  71.                     ps^.f[1].cmd := $8050;
  72.                     ch := true;
  73.                     end
  74.                 else if (ps^.sz = 2) & (ps^.f[2].cmd = 40)  &
  75.                     ((ps^.f[1].cmd = $8050) | (ps^.f[1].cmd = $8050)) then begin
  76.                     hUnlock(handle(res));
  77.                     iff := munger (handle(res), 6+6*res^^.sz+8, nil, 8, @iff, 0);
  78.                     hLock(handle(res));
  79.                     ptr(Ps) := ptr(ord4(res^)+4+6*res^^.sz);
  80.                     uff := uff-8;
  81.                     ps^.sz := ps^.sz-1;
  82.                     ch := true;
  83.                      end;
  84.                 for j := 1 to ps^.sz do 
  85.                     if ps^.f[j].cmd < 0 then begin
  86.                         ch := true;
  87.                         ps^.f[j].Mod2 := ps^.f[j].Mod2 + uff;
  88.                         end;
  89.                 hUnlock(handle(res));
  90.                 if ch then begin
  91.                     changedresource(handle(res));
  92.                     writeresource(handle(res));
  93.                     end;
  94.                 end;
  95.             end;
  96.     END;
  97.  
  98.  
  99. END.
  100.  
  101.  
  102.  
  103. (* compile and link:
  104. pascal HyperSnd.p -i "{XCMDs}"
  105. link -o 80:HyperSound -rt XCMD=0 -sn Main=HyperSound -m ENTRYPOINT HyperSnd.p.o {libraries}interface.o 
  106. *)
  107.